MacFormat 1994 November/macformat-018.iso/Utility Spectacular/Developer/QB->FB/qbCLR.incl

Text File | 1993-02-23 | 8.5 KB | 283 lines | [TEXT/ZBAS]

'
' qbCLR include
'
' some re-written routines to match the CLR calls available in QB as
' well as some general purpose routines former QB users may find useful.
'

INCLUDE FILE _aplIncl
'
' --- RESOURCE FUNCTIONS -------------------------------

LOCAL FN qbAddResource (resHndl&, restype&, resID%, resName$)
  tmpHndl& = FN GETRESOURCE (restype&, resID%)           'is resource already there?
  LONG IF tmpHndl& <> 0 AND SYSERROR = _noErr            'no errors?
    CALL RMVERESOURCE (tmpHndl&)                         'delete old copy
  END IF
  CALL ADDRESOURCE (resHndl&, restype&, resID%, resName$)'add new resource
  CALL WRITERESOURCE (resHndl&)                          'write to file
  DEF DISPOSEH (resHndl&)
END FN


LOCAL FN qbAddCursor (resHndl&, resID%, resName$)
  FN qbAddResource (resHndl&, _"CURS", resID%, resName$)
END FN


LOCAL FN qbAddIcon (resHndl&, resID%, resName$)
  FN qbAddResource (resHndl&, _"ICON", resID%, resName$)
END FN


LOCAL FN qbAddPattern (resHndl&, resID%, resName$)
  FN qbAddResource (resHndl&, _"PAT ", resID%, resName$)
END FN


LOCAL FN qbAddPicture (resHndl&, resID%, resName$)
  FN qbAddResource (resHndl&, _"PICT", resID%, resName$)
END FN


LOCAL FN qbAddString (resHndl&, resID%, resName$)
  FN qbAddResource (resHndl&, _"STR ", resID%, resName$)
END FN


LOCAL FN qbMakeHandle (arrayPtr&, arraySize%)
  resHndl& = 0
  resHndl& = FN NEWHANDLE (arraySize%)
  LONG IF resHndl& <> 0 AND SYSERROR = _noErr
    osErr = FN HLOCK (resHndl&)
    BLOCKMOVE arrayPtr&, [resHndl&], numBytes%
    osErr = FN HUNLOCK (resHndl&)
  END IF
END FN = resHndl&


LOCAL FN qbSaveArray (arrayPtr&, arraySize%, resID%, resName$, type&)
  resHndl& = FN qbMakeHandle (arrayPtr&, arraySize%)
  LONG IF resHndl& <> 0
    IF type& = 0 THEN type& = _"GNRL"
    FN qbAddResource (resHndl&, type&, resID%, resName$)
  END IF
END FN


LOCAL FN qbSaveCursor (resID%, arrayPtr&, resName$)
  resHndl& = FN qbMakeHandle (arrayPtr&, arraySize%)
  LONG IF resHndl& <> 0
    FN qbAddResource (resHndl&, _"CURS", resID%, resName$)
  END IF
END FN


LOCAL FN qbSaveIcon (resID%, arrayPtr&, resName$)
  resHndl& = FN qbMakeHandle (arrayPtr&, arraySize%)
  LONG IF resHndl& <> 0
    FN qbAddResource (resHndl&, _"ICON", resID%, resName$)
  END IF
END FN



LOCAL FN qbSavePattern (resID%, arrayPtr&, resName$)
  resHndl& = FN qbMakeHandle (arrayPtr&, arraySize%)
  LONG IF resHndl& <> 0
    FN qbAddResource (resHndl&, _"PAT ", resID%, resName$)
  END IF
END FN


' ••• ???????????
LOCAL FN qbSavePicture (resID%, @pictPtr&, resName$)
  resHndl& = FN qbMakeHandle (pictPtr&, pictSize%)
  LONG IF resHndl& <> 0
    FN qbAddResource (resHndl&, _"PICT", resID%, resName$)
  END IF
END FN


' ••• ???????????
LOCAL FN qbSaveString (resID%, @arrayPtr&, resName$)
  resHndl& = FN qbMakeHandle (arrayPtr&, PEEK(arrayPtr&))
  LONG IF resHndl& <> 0
    FN qbAddResource (resHndl&, _"STR ", resID%, resName$)
  END IF
END FN



LOCAL FN qbRsrcToArray (resID, arrayPtr&, resType&)
  tmpHndl& = FN GETRESOURCE (resType&, resID)            'is resource already there?
  LONG IF tmpHndl& <> 0 AND SYSERROR = _noErr            'no errors?
    hndlSize& = FN GETHANDLESIZE(tmpHndl&)
    osErr = FN HLOCK (tmpHndl&)
    BLOCKMOVE [tmpHndl&], arrayPtr&, hndlSize&
    osErr = FN HUNLOCK (tmpHndl&)
    DEF DISPOSEH (tmpHndl&)
  END IF
END FN


LOCAL FN qbLoadArray (resID, @arrayPtr&, resType$)
  resType& = CVI(resType$)
  IF resType& = 0 THEN resType& = _"GNRL"
  FN qbRsrcToArray (resID, arrayPtr&, resType&)
END FN


LOCAL FN qbLoadCursor (resID, @arrayPtr&)
  FN qbRsrcToArray (resID, arrayPtr&, _"CURS")
END FN


LOCAL FN qbLoadIcon (resID, @arrayPtr&)
  FN qbRsrcToArray (resID, arrayPtr&, _"ICON")
END FN


LOCAL FN qbLoadPattern (resID, @arrayPtr&)
  FN qbRsrcToArray (resID, arrayPtr&, _"PAT ")
END FN


LOCAL FN qbLoadPicture (resID, @arrayPtr&)
  FN qbRsrcToArray (resID, arrayPtr&, _"PICT")
END FN


LOCAL FN qbLoadString (resID, @arrayPtr&)
  FN qbRsrcToArray (resID, arrayPtr&, _"STR ")
END FN



' --- GRAPHIC FUNCTIONS -----------------------------------

LOCAL FN qbDrawLines (@xPtr&, @yPtr&, @indxPtr&, numElems%)
  indxPos = {indxPtr&}                                   'read index value
  offset% = indxPos * 2                                  'calc actual offset
  CALL MOVETO ({xPtr& + offset%}, {yPtr& + offset%})     'move the pen there
  FOR lineCount = 1 TO numElems%                         'now cycle through positions
    indxPos = {indxPtr& + (lineCount * 2)}               'get next index value in sequence
    offset% = indxPos * 2                                'calc actual offset
    CALL LINETO ({xPtr& + offset%}, {yPtr& + offset%})   'draw line there
  NEXT lineCount                                         'cycle until done
END FN



' --- OTHER FUNCTIONS -----------------------------------


CLEAR LOCAL
DIM pBlock.128
DIM 63 dirName$
DIM 255 pathName$
LOCAL FN qbGetPathName$ (fName$, vRefNum%)
  pathName$ = fName$                                     'put filename in pathname
  pBlock.ioNamePtr&      = @dirName$                     'put pointer to dirName$
  pBlock.ioVRefNum%      = vRefNum%                      'set vRefNun
  pBlock.ioDrParID&      = [_curDirStore]                'get currect directory ID
  pBlock.ioFDirIndex%    = -1                            'get info on folder

  DO
    osErr% = FN GETCATINFO (@pBlock)                     'get catalog info
    LONG IF osErr% = _noErr                              'no error then...
      pathName$ =  dirName$ + ":" + pathName$            'add dirName to path
      pBlock.ioDrDirID& = pBlock.ioDrParID&              'get folder's parent ID
    END IF
  UNTIL pBlock.ioDirID& = _fsRtParID                     'volume root ID
END FN = pathName$


LOCAL FN qbGetFileInfo (fName$, @pbPtr&)
  pbPtr&.ioNamePtr&      = @fName$                       'put pointer to dirName$
  pbPtr&.ioVRefNum%      = -{_sfSaveDisk}                'get vRefNun
  pbPtr&.ioDrParID&      = [_curDirStore]                'get currect directory ID
  osErr% = FN GETFILEINFO (pbPtr&)                       'get catalog info
END FN


CLEAR LOCAL
DIM pt.4
DIM rect.8
LOCAL FN qbPtInRects (@ptPtr&, @rectPtr&, numRect, first, @boolPtr&)
  pt;4 = ptPtr&
  FOR count = first TO numRect
    rect;8 = rectPtr& + (count * 8)
    bool%  = FN PTINRECT (pt, rect)
    POKE WORD (boolPtr& + (count * 2)), bool%
  NEXT count
END FN


CLEAR LOCAL
DIM pBlock.128
LOCAL FN qbPIC2PICTRsrc (fileName$, vRefNum%, resID)
  OPEN "ID", #1, fileName$,, vRefNum%                    'open file ocntaining PICT string
  fileSize = LOF (1,1)                                   'get file size
  resHndl& = FN NEWHANDLE (fileSize)                     'create handle of that size
  LONG IF resHndl& <> 0 AND SYSERROR = _noErr            'no errors
    osErr = FN HLOCK (resHndl&)                          'lock handle
    READ FILE#1, [resHndl&], fileSize                    'copy string data to handle
    osErr = FN HUNLOCK (resHndl&)                        'unlock handle
    CLOSE #1                                             'close the file

    fileRsrc$ = fileName$ + ".rsrc"                      'change name
    vRefNum% = FOLDER ("", vRefNum%)                     'open folder to save file into
    CALL CREATERESFILE (fileRsrc$)                       'create a new file w/rsrc fork
    LONG IF FN RESERROR = _noErr                         'no errors so far
      resRef = USR OPENRFPERM (fileRsrc$, vRefNum%, _fsCurPerm)'open file’s rsrc fork
      LONG IF resRef <> 0 AND FN RESERROR = _noErr       'still no errors?
        FN qbAddResource (resHndl&, _"PICT", resID, fileName$)'add PICT rsrc
        CALL CLOSERESFILE (resRef)                       'close when done
      END IF
    END IF
  END IF
END FN


' --- DIALOG FUNCTIONS -----------------------------------


LOCAL FN qbGetDialogBtn (dlogPtr&, itemID%)
  DIM itemRect.8
  CALL GETDITEM (dlogPtr&, itemID%, itemType%, itemHndl&, itemRect)
  LONG IF itemHndl& <> 0
    btnValue% = FN GETCTLVALUE (itemHndl&)
  END IF
END FN = btnValue%


LOCAL FN qbGetDialogText$ (dlogPtr&, itemID%)
  DIM itemRect.8
  CALL GETDITEM (dlogPtr&, itemID%, itemType%, itemHndl&, itemRect)
  LONG IF itemHndl& <> 0
    CALL GETITEXT (dlogPtr&, itemText$)
  END IF
END FN = itemText$


LOCAL FN qbSetDialogBtn (dlogPtr&, itemID%, btnValue%)
  DIM itemRect.8
  CALL GETDITEM (dlogPtr&, itemID%, itemType%, itemHndl&, itemRect)
  LONG IF itemHndl& <> 0
    CALL SETCTLVALUE (itemHndl&, btnValue%)
  END IF
END FN


LOCAL FN qbSetDialogText (dlogPtr&, itemID%, itemText$)
  DIM itemRect.8
  CALL GETDITEM (dlogPtr&, itemID%, itemType%, itemHndl&, itemRect)
  LONG IF itemHndl& <> 0
    CALL SETITEXT (dlogPtr&, itemText$)
  END IF
END FN